home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Technotools
/
Technotools (Chestnut CD-ROM)(1993).ISO
/
lantools
/
sam303
/
sam.bas
< prev
next >
Wrap
BASIC Source File
|
1991-03-01
|
46KB
|
1,236 lines
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Main Module Name: SAM.BAS ║
'╟─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────╢
'║ ║
'║ Purpose: S.A.M. (Server Activity Monitor) for LANtastic (tm) Networks. ║
'║ ║
'║ Source: Humbleware Custom Programming, Paul Martin Drive, Baltimore MD 21227, (H#) 301-799-1975 (W#) 301-685-7111 ║
'║ ║
'║ Author: Lawrence A. Westhaver ║
'║ ║
'║ Last Revision: March 1st 1991 ║
'║ ║
'║ Language: Microsoft BASIC Professional Development System (PDS) ║
'║ ║
'╟─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────╢
'║ ║
'║ To run SAM interactively inside QBX environment: QBX SAM.BAS /L QBX.QLB ║
'║ ║
'╟─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────╢
'║ ║
'║ To create a DOS command line executable SAM.EXE: ║
'║ ║
'║ Libraries: QBX.QLB & QBX.LIB ║
'║ ║
'║ Stub Files: TSCNIONR.OBJ ║
'║ ║
'║ Compiler Switches: /O /Ot /FPA ║
'║ ║
'║ BC Command line: BC SAM.BAS, SAM.OBJ, NUL /O /Ot /FPA; ║
'║ ║
'║ Microsoft (R) BASIC Compiler Version 7.00 ║
'║ Copyright (C) Microsoft Corporation 1982-1989. All rights reserved. ║
'║ ║
'║ Linker Switches: /EX /NOE ║
'║ ║
'║ LINK Command line: LINK /EX /NOE SAM+TSCNIONR, SAM.EXE, NUL, QBX; ║
'║ ║
'║ Microsoft (R) Segmented-Executable Linker Version 5.05 ║
'║ Copyright (C) Microsoft Corp 1984-1989. All rights reserved. ║
'║ ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
'define data structure used by InterruptX()
TYPE RegTypeX
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
'declare functions
DECLARE FUNCTION Parser$ (Delimiters$, InputString$)
DECLARE FUNCTION RedirIsThere% ()
DECLARE FUNCTION NOSVersion% ()
DECLARE FUNCTION LoggedInto% (Server$)
DECLARE FUNCTION TimeOut% (Seconds%, Default%)
DECLARE FUNCTION Rollover% ()
'declare sub-programs
DECLARE SUB InterruptX (IntNum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX)
DECLARE SUB DrawUpperScreen ()
DECLARE SUB DrawLowerScreen ()
DECLARE SUB UpdateScreen ()
DECLARE SUB ShowUsage ()
'define logical constants
CONST TRUE% = -1
CONST FALSE% = 0
'declare global variables
COMMON SHARED InReg AS RegTypeX, OutReg AS RegTypeX
COMMON SHARED BanrFG%, BanrBG%, InstFG%, InstBG%, BrdrFG%, BrdrBG%, TitlFG%, TitlBG%, TextFG%, TextBG%, ArowFG%, ArowBG%, StatFG%, StatBG%, NormFG%, NormBG%
COMMON SHARED PageStart%, State$(), LastCmd$(), Server$, Interval%, DisplayOption%
'move segment pointer into the BIOS data area
DEF SEG = 0
'peek into BIOS data area to determine monitor type
IF PEEK(&H463) <> &HB4 THEN
'If we have a color monitor, use the following colors a la' LANtastic (tm)
BanrFG% = 15 'upper and lower program ID banners
BanrBG% = 1
InstFG% = 14 'banner instructional hilites
InstBG% = 1
BrdrFG% = 6 'window border
BrdrBG% = 7
TitlFG% = 0 'titles within window border
TitlBG% = 7
TextFG% = 15 'text within window border
TextBG% = 4
ArowFG% = 14 'scroll indicators (arrows)
ArowBG% = 7
StatFG% = 15 'status panel hilites
StatBG% = 7
NormFG% = 7 'normal DOS color
NormBG% = 0
ELSE
'If we have a monochrome monitor, use only bright whites, whites and blacks
BanrFG% = 0 'upper and lower program ID banners
BanrBG% = 7
InstFG% = 0 'banner instructional hilites
InstBG% = 7
BrdrFG% = 7 'window border
BrdrBG% = 0
TitlFG% = 7 'titles within window border
TitlBG% = 0
TextFG% = 15 'text within window border
TextBG% = 0
ArowFG% = 15 'scroll indicators (arrows)
ArowBG% = 0
StatFG% = 15 'status panel hilites
StatBG% = 0
NormFG% = 7 'normal DOS color
NormBG% = 0
END IF
'move segment pointer back to BASIC's data segment
DEF SEG
'position pointer to display users from top of list
PageStart% = 1
'allocate memory for login state flags
DIM State$(0 TO 255)
'generate all possible login state flag combinations and place them
'in a look-up table... the look-up table approach is much faster
'than generating the flags as needed during program execution
FOR Index% = 0 TO 255
'create an un-initialized state flag string
State$(Index%) = STRING$(8, "-")
'set Access Control List (ACL) privelege flag
IF Index% AND 128 THEN MID$(State$(Index%), 1) = "A"
'set Queue privelege flag
IF Index% AND 64 THEN MID$(State$(Index%), 2) = "Q"
'set Peer privelege flag
IF Index% AND 32 THEN MID$(State$(Index%), 3) = "P"
'set Mail privelege flag
IF Index% AND 16 THEN MID$(State$(Index%), 4) = "M"
'set User-audit-entry privelege flag
IF Index% AND 8 THEN MID$(State$(Index%), 5) = "U"
'set Remote Program Load (RPL) flag
IF Index% AND 2 THEN MID$(State$(Index%), 7) = "R"
'set fully Logged-In flag
IF Index% AND 1 THEN MID$(State$(Index%), 8) = "L"
NEXT Index%
'allocate memory for NOS messages
DIM LastCmd$(0 TO 39)
'define NOS messages
LastCmd$(0) = "Log into a server "
LastCmd$(1) = "Terminate process "
LastCmd$(2) = "Open a file "
LastCmd$(3) = "Close a file "
LastCmd$(4) = "Create/Overwrite a file "
LastCmd$(5) = "Create a new file "
LastCmd$(6) = "Create a unique file "
LastCmd$(7) = "Commit data to disk "
LastCmd$(8) = "Read from a file "
LastCmd$(9) = "Write to a file "
LastCmd$(10) = "Delete a file "
LastCmd$(11) = "Set file attributes "
LastCmd$(12) = "Lock byte range "
LastCmd$(13) = "Unlock byte range "
LastCmd$(14) = "Create a subdirectory "
LastCmd$(15) = "Delete a subdirectory "
LastCmd$(16) = "Rename a file "
LastCmd$(17) = "Find first file match "
LastCmd$(18) = "Find next file match "
LastCmd$(19) = "Get disk free space "
LastCmd$(20) = "Get a queue entry "
LastCmd$(21) = "Set a queue entry "
LastCmd$(22) = "Control the queue "
LastCmd$(23) = "Get login information "
LastCmd$(24) = "Get link description "
LastCmd$(25) = "Seek to a file position "
LastCmd$(26) = "Get server's time "
LastCmd$(27) = "Create an audit entry "
LastCmd$(28) = "Open file in multi-mode "
LastCmd$(29) = "Change a password "
LastCmd$(30) = "Disable user account "
LastCmd$(31) = "Local server file copy "
LastCmd$(32) = "Get username from acct "
LastCmd$(33) = "Translate a path "
LastCmd$(34) = "Create an indirect file "
LastCmd$(35) = "Get indirect file text "
LastCmd$(36) = "Get phys printer status "
LastCmd$(37) = "Get logical stream info "
LastCmd$(38) = "Set logical stream info "
LastCmd$(39) = "Get user account record "
'check for minimum NOS configuration
IF NOT RedirIsThere% THEN
PRINT "Error: Artisoft network redirector (REDIR.EXE) not loaded"
END
END IF
'check for known compatible NOS version numbers
IF (NOSVersion% < 300) OR (NOSVersion% > 303) THEN
PRINT "Error: Artisoft network redirector (REDIR.EXE) version 3.00 to 3.03 required"
END
END IF
'fetch DOS command line
CmdLine$ = COMMAND$
'is command line empty?
IF CmdLine$ = "" THEN
CALL ShowUsage
PRINT "Error: You must specify the name of a server to monitor"
END
END IF
'fetch server name from command line
Server$ = Parser$(" ", CmdLine$)
IF NOT LoggedInto%(Server$) THEN
CALL ShowUsage
PRINT "Error: Can't find server, make sure you are logged into the specified server"
END
END IF
'fetch command line switches
DO
'return next token
temp$ = Parser$(" " + CHR$(9), CmdLine$)
'fetch display option from command line
IF LEFT$(temp$, 2) = "W=" THEN
IF (MID$(temp$, 3, 1) <> "P") AND (MID$(temp$, 3, 1) <> "S") THEN
CALL ShowUsage
PRINT "Error: Incorrect window option given, legal options are P or S"
END
END IF
IF MID$(temp$, 3, 1) = "P" THEN
DisplayOption% = 0
ELSE
DisplayOption% = 1
END IF
END IF
'fetch user number from command line
IF LEFT$(temp$, 2) = "U=" THEN
PageStart% = VAL(MID$(temp$, 3))
IF PageStart% < 1 OR PageStart% > 290 THEN
CALL ShowUsage
PRINT "Error: User number is out of range, legal range is 1 to 290"
END
END IF
END IF
'fetch update interval from command line
IF LEFT$(temp$, 2) = "I=" THEN
Interval% = VAL(MID$(temp$, 3))
IF Interval% < 0 OR Interval% > 300 THEN
CALL ShowUsage
PRINT "Error: Interval is out of range, legal range is 0 to 300 seconds"
END
END IF
END IF
LOOP UNTIL CmdLine$ = ""
'draw screen
CALL DrawUpperScreen
CALL DrawLowerScreen
'scan for users
CALL UpdateScreen
'main program loop
DO
'force garbage collection
FreeStr& = FRE("")
'fetch a keypress
KeyCode% = TimeOut%(Interval%, 32)
SELECT CASE KeyCode%
CASE 13 'carriage return
DisplayOption% = DisplayOption% + 1
IF DisplayOption% > 1 THEN
DisplayOption% = 0
END IF
CALL DrawUpperScreen
COLOR StatFG%, StatBG%
LOCATE 22, 23
SELECT CASE DisplayOption%
CASE 0
PRINT "Primary ";
CASE 1
PRINT "Secondary";
END SELECT
'force an update
KeyCode% = 32
CASE 27 'escape
COLOR NormFG%, NormBG%
CLS
LOCATE , , 1
PRINT "SAM - Server Activity Monitor Version 3.03 for LANtastic (tm) networks"
PRINT
PRINT " (C) Copyright 1990 Humbleware Custom Programming"
PRINT " 247 Paul Martin Drive"
PRINT " Baltimore, MD 21227"
PRINT " (301) 799-1975"
PRINT
END
CASE -72 'up arrow
PageStart% = PageStart% - 1
IF PageStart% < 1 THEN
PageStart% = 1
END IF
COLOR StatFG%, StatBG%
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'force an update
KeyCode% = 32
CASE -73 'page up
PageStart% = PageStart% - 11
IF PageStart% < 1 THEN
PageStart% = 1
END IF
COLOR StatFG%, StatBG%
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'force an update
KeyCode% = 32
CASE -71 'home
PageStart% = 1
COLOR StatFG%, StatBG%
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'force an update
KeyCode% = 32
CASE -80 'down arrow
PageStart% = PageStart% + 1
IF PageStart% > 290 THEN
PageStart% = 290
END IF
COLOR StatFG%, StatBG%
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'force an update
KeyCode% = 32
CASE -81 'page down
PageStart% = PageStart% + 11
IF PageStart% > 290 THEN
PageStart% = 290
END IF
COLOR StatFG%, StatBG%
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'force an update
KeyCode% = 32
CASE -79 'end
PageStart% = 290
COLOR StatFG%, StatBG%
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'force an update
KeyCode% = 32
CASE 43 'increment interval
Interval% = Interval% + 1
IF Interval% > 300 THEN
Interval% = 0
END IF
COLOR StatFG%, StatBG%
LOCATE 22, 65
PRINT RIGHT$("000" + LTRIM$(STR$(Interval%)), 3);
CASE 45 'decrement interval
Interval% = Interval% - 1
IF Interval% < 0 THEN
Interval% = 300
END IF
COLOR StatFG%, StatBG%
LOCATE 22, 65
PRINT RIGHT$("000" + LTRIM$(STR$(Interval%)), 3);
END SELECT
'if keypress is spacebar then update screen
IF KeyCode% = 32 THEN
CALL UpdateScreen
END IF
LOOP
'EOP: SAM
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Sub-Program Name: DrawLowerScreen ║
'║ Purpose: Draws lower half of S.A.M. (server activity monitor) screen. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
SUB DrawLowerScreen
COLOR BanrFG%, BanrBG%
LOCATE 1, 1: PRINT "SAM - Server Activity Monitor (C) Copyright 1990 Humbleware Custom Programming";
COLOR NormFG%, NormBG%
LOCATE 2, 1: PRINT SPACE$(80);
LOCATE 18, 1: PRINT SPACE$(80);
COLOR BrdrFG%, BrdrBG%
LOCATE 19, 1: PRINT "╔══════════════════════════════════════════════════════════════════════════════╗";
LOCATE 20, 1: PRINT "║ ║";
LOCATE 21, 1: PRINT "╟──────────────────────────────────────────────────────────────────────────────╢";
LOCATE 22, 1: PRINT "║ ║";
LOCATE 23, 1: PRINT "╚══════════════════════════════════════════════════════════════════════════════╝";
COLOR TitlFG%, TitlBG%
LOCATE 20, 2: PRINT " Monitoring Server: Monitoring Users: to ";
LOCATE 22, 2: PRINT " Display Window: Update Interval: Second(s) ";
COLOR NormFG%, NormBG%
LOCATE 24, 1: PRINT SPACE$(80);
COLOR BanrFG%, BanrBG%
LOCATE 25, 1: PRINT " -Toggle Display, -Quit, / -Scroll, / -Change Update Interval";
COLOR InstFG%, InstBG%
LOCATE 25, 1: PRINT "["; CHR$(17); CHR$(196); CHR$(217); "]";
LOCATE 25, 23: PRINT "[Esc]";
LOCATE 25, 35: PRINT "["; CHR$(24); "]";
LOCATE 25, 39: PRINT "["; CHR$(25); "]";
LOCATE 25, 51: PRINT "[+]";
LOCATE 25, 55: PRINT "[-]";
END SUB 'DrawLowerScreen
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Sub-Program Name: DrawUpperScreen ║
'║ Purpose: Draws upper half of S.A.M. (server activity monitor) screen. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
SUB DrawUpperScreen
'turn cursor off
LOCATE , , 0
'decide which display option we're using
SELECT CASE DisplayOption%
'primary display window
CASE 0
COLOR BrdrFG%, BrdrBG%
LOCATE 3, 1: PRINT "╔════╤═══════════════╤═══════════════╤════════╤══════════╤═════════════════╤═══╗";
LOCATE 4, 1: PRINT "║ │ │ │ │ │ │ ║";
COLOR TitlFG%, TitlBG%
LOCATE 4, 2: PRINT "VCID";
LOCATE 4, 7: PRINT " Machine Name ";
LOCATE 4, 23: PRINT " User Name ";
LOCATE 4, 39: PRINT " State ";
LOCATE 4, 48: PRINT " Requests ";
LOCATE 4, 59: PRINT " I/O Bytes ";
LOCATE 4, 77: PRINT "LCI";
COLOR BrdrFG%, BrdrBG%
LOCATE 5, 1: PRINT "╠════╪═══════════════╪═══════════════╪════════╪══════════╪═════════════════╪═══╣";
FOR Index% = 6 TO 16
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 1: PRINT CHR$(186);
COLOR TextFG%, TextBG%: LOCATE Index%, 2: PRINT SPACE$(4);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 6: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 7: PRINT SPACE$(15);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 22: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 23: PRINT SPACE$(15);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 38: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 39: PRINT SPACE$(8);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 47: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 48: PRINT SPACE$(10);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 58: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 59: PRINT SPACE$(17);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 76: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 77: PRINT SPACE$(3);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 80: PRINT CHR$(186);
NEXT Index%
COLOR BrdrFG%, BrdrBG%
LOCATE 17, 1: PRINT "╚════╧═══════════════╧═══════════════╧════════╧══════════╧═════════════════╧═══╝";
'secondary display window
CASE 1
COLOR BrdrFG%, BrdrBG%
LOCATE 3, 1: PRINT "╔═══════════════╤════════╤══════════╤═════════════════╤════════════════════════╗";
LOCATE 4, 1: PRINT "║ │ │ │ │ ║";
COLOR TitlFG%, TitlBG%
LOCATE 4, 2: PRINT " User Name ";
LOCATE 4, 18: PRINT " State ";
LOCATE 4, 27: PRINT " Requests ";
LOCATE 4, 38: PRINT " I/O Bytes ";
LOCATE 4, 56: PRINT " Last Command Issued ";
COLOR BrdrFG%, BrdrBG%
LOCATE 5, 1: PRINT "╠═══════════════╪════════╪══════════╪═════════════════╪════════════════════════╣";
FOR Index% = 6 TO 16
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 1: PRINT CHR$(186);
COLOR TextFG%, TextBG%: LOCATE Index%, 2: PRINT SPACE$(15);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 17: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 18: PRINT SPACE$(8);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 26: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 27: PRINT SPACE$(10);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 37: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 38: PRINT SPACE$(17);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 55: PRINT CHR$(179);
COLOR TextFG%, TextBG%: LOCATE Index%, 56: PRINT SPACE$(24);
COLOR BrdrFG%, BrdrBG%: LOCATE Index%, 80: PRINT CHR$(186);
NEXT Index%
COLOR BrdrFG%, BrdrBG%
LOCATE 17, 1: PRINT "╚═══════════════╧════════╧══════════╧═════════════════╧════════════════════════╝";
END SELECT
END SUB 'DrawUpperScreen
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Function Name: LoggedInto% ║
'║ Purpose: Returns a TRUE value if logged into specified server, FALSE otherwise. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
FUNCTION LoggedInto% (Server$)
'initialize index
Index% = 0
'main loop
DO
'allocate buffer to receive server name
AvailableServer$ = STRING$(16, 0)
'set up interrupt routine
InReg.ES = SSEG(AvailableServer$) 'load ES with segment of AvailableServer$
InReg.DI = SADD(AvailableServer$) 'load DI with offset of AvailableServer$
InReg.AX = &H5F80 'load AX with 5f80h
InReg.BX = Index% 'load BX with index
'execute interrupt
CALL InterruptX(&H21, InReg, OutReg)
'have we run out of servers?
IF (OutReg.FLAGS AND 1) THEN
LoggedInto% = FALSE
EXIT DO
END IF
'do we have a server name match?
IF UCASE$(Server$) = "\\" + RTRIM$(LEFT$(AvailableServer$, 15)) THEN
LoggedInto = TRUE
EXIT DO
END IF
'point to next server entry
Index% = Index% + 1
LOOP
END FUNCTION 'LoggedInto%
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Function Name: FNNOSVer% ║
'║ Purpose: Returns Artisoft NOS version number in integer format. Version number 2.53 would be returned as 253. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
FUNCTION NOSVersion%
'set up interrupt routine
InReg.AX = &HB809
'execute interrupt
CALL InterruptX(&H2F, InReg, OutReg)
'interpret results
NOSVersion% = ((OutReg.AX \ 256) * 100) + (OutReg.AX AND 255)
END FUNCTION 'NOSVersion%
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Function Name: Parser$ ║
'║ Purpose: Parses an input string into tokens. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
FUNCTION Parser$ (Delimiters$, InputString$)
'check for empty input string
IF InputString$ = "" THEN
Parser$ = ""
EXIT FUNCTION
END IF
'get length of input string for future reference
InputStringLength% = LEN(InputString$)
'throw away leading delimiters to find beginning of first token
FOR PointerToStartOfToken% = 1 TO InputStringLength%
'jump out when we find a non-delimiter
IF INSTR(Delimiters$, MID$(InputString$, PointerToStartOfToken%, 1)) = 0 THEN
EXIT FOR
END IF
NEXT PointerToStartOfToken%
'resume scanning from where we left off to find end of first token
FOR PointerToEndOfToken% = PointerToStartOfToken% TO InputStringLength%
'jump out when we find a delimiter
IF INSTR(Delimiters$, MID$(InputString$, PointerToEndOfToken%, 1)) <> 0 THEN
EXIT FOR
END IF
NEXT PointerToEndOfToken%
'see if we ran off the end of the input string looking for a non-delimiter
'if we did, then the input string contained no tokens
IF PointerToStartOfToken% > InputStringLength% THEN
Parser$ = ""
InputString$ = ""
EXIT FUNCTION
END IF
'see if we ran off the end of the input string looking for a delimiter
'if we did, then the rest of the input string is a single token
IF PointerToEndOfToken% > InputStringLength% THEN
Parser$ = MID$(InputString$, PointerToStartOfToken%)
InputString$ = ""
EXIT FUNCTION
END IF
'if we made it this far then we have pointers to the beginning and end
'of a token, let's send it back to the caller
Parser$ = MID$(InputString$, PointerToStartOfToken%, PointerToEndOfToken% - PointerToStartOfToken%)
'now we'll remove the token from the input string so it won't get processed again
InputString$ = MID$(InputString$, PointerToEndOfToken%)
END FUNCTION 'Parser$
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Function Name: RedirIsThere% ║
'║ Purpose: Returns TRUE if Artisoft's REDIR.EXE is installed, FALSE otherwise. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
FUNCTION RedirIsThere%
'load AX with b800h
InReg.AX = &HB800
'execute interrupt
CALL InterruptX(&H2F, InReg, OutReg)
'neither redir or server is installed
IF (OutReg.AX AND 255) = 0 THEN
'set flag to false
RedirIsThere% = FALSE
'something is installed
ELSE
'is it redir?
IF ((OutReg.BX AND 255) AND 8) THEN
'set flag to true
RedirIsThere% = TRUE
ELSE
'set flag to false
RedirIsThere% = FALSE
END IF
END IF
END FUNCTION 'RedirIsThere%
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Function Name: RollOver% ║
'║ Purpose: Fetches the BIOS midnight rollover flag from the BIOS data area. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
FUNCTION Rollover%
'move BASIC's segment pointer to BIOS data area
DEF SEG = &H40
'get BIOS date rollover flag
Rollover% = PEEK(&H70)
'move BASIC's segment pointer back to BASIC's own data segment
DEF SEG
END FUNCTION 'Rollover%
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Subroutine Name: Usage ║
'║ Purpose: Prints usage instructions for SAM (server activity monitor). ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
SUB ShowUsage
PRINT
PRINT "Usage: SAM \\Servername [ [W={P|S}] [U=nnn] [I=nnn] ]"
PRINT
PRINT " \\Servername Name of network server to be monitored"
PRINT
PRINT " Switch │ Meaning │ Default │ Options "
PRINT " W= │ display primary or secondary Window │ P │ P or S "
PRINT " U= │ monitor Users starting at user nnn │ 1 │ 1 to 290 "
PRINT " I= │ sets update Interval to nnn seconds │ 0 │ 0 to 300 "
PRINT
PRINT " SAM \\Server W=S - Monitors "; CHR$(34); "Server"; CHR$(34); ", display secondary window"
PRINT " SAM \\Server U=2 - Monitors "; CHR$(34); "Server"; CHR$(34); ", monitor users starting at user 2"
PRINT " SAM \\Server I=5 - Monitors "; CHR$(34); "Server"; CHR$(34); ", sets update interval to 5 seconds"
PRINT
END SUB 'ShowUsage
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Function Name: TimeOut% ║
'║ Purpose: Waits for keyboard input for a specified time period. Returns a default character if time elapses. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
FUNCTION TimeOut% (Seconds%, Default%) STATIC
'move BASIC's segment pointer to BIOS data area
DEF SEG = &H40
'convert seconds to clock ticks
TicksToWait% = Seconds% * 18
'reset counter
TickCount% = 0
'fetch current clock tick
ClockLowByte% = PEEK(&H6C)
'main loop
DO
'has at least one clock tick passed?
IF ClockLowByte% <> PEEK(&H6C) THEN
'update ClockLowByte
ClockLowByte% = PEEK(&H6C)
'increment tick counter
TickCount% = TickCount% + 1
END IF
'check for a keypress
KeyCode$ = INKEY$
'interpret keypress
SELECT CASE LEN(KeyCode$)
'got a regular keypress
CASE 1
'return positive value for regular keys
TimeOut% = ASC(KeyCode$)
EXIT DO
'got an extended keypress
CASE 2
'return negative value for extended keys
TimeOut% = -ASC(RIGHT$(KeyCode$, 1))
EXIT DO
END SELECT
'is it time to exit?
IF TickCount% >= TicksToWait% THEN
'return default character
TimeOut% = Default%
EXIT DO
END IF
'end main loop
LOOP
'move BASIC's segment pointer back to BASIC's own data segment
DEF SEG = 0
END FUNCTION 'TimeOut%
'╔═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╗
'║ Subroutine Name: UpdateScreen ║
'║ Purpose: Updates S.A.M. (server activity monitor) screen. ║
'╚═════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════╝
'
SUB UpdateScreen STATIC
'if BIOS midnight rollover flag has been set then force DOS to update
'it's internal clock by making a dummy DOS get-time function call
IF Rollover% THEN
temp$ = TIME$
END IF
'condition server name
ConditionedServer$ = Server$ + CHR$(0)
'set color used by the following prints
COLOR StatFG%, StatBG%
'print display option
LOCATE 22, 23
SELECT CASE DisplayOption%
CASE 0
PRINT "Primary ";
CASE 1
PRINT "Secondary";
END SELECT
'print server name
LOCATE 20, 23
PRINT MID$(Server$, 3);
'print monitor range
LOCATE 20, 65
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart%)), 3);
LOCATE 20, 72
PRINT RIGHT$("000" + LTRIM$(STR$(PageStart% + 10)), 3);
'print update interval
LOCATE 22, 65
PRINT RIGHT$("000" + LTRIM$(STR$(Interval%)), 3);
'set color used by the following prints
COLOR TextFG%, TextBG%
'point to first print line in display window
Vert% = 6
'reset login counter
LoginCount% = 0
'seed the login index
OutReg.BX = 0
'scan for logins
DO
'declare buffer to receive data
UserEntry$ = SPACE$(44)
'set up interrupt routine
InReg.AX = &H5FB0 'load AX with 5fb0h
InReg.BX = OutReg.BX 'load BX with scan index
InReg.DS = SSEG(UserEntry$) 'load DS with segment of UserEntry$
InReg.SI = SADD(UserEntry$) 'load SI with offset of UserEntry$
InReg.ES = SSEG(ConditionedServer$) 'load ES with segment of ConditionedServer$
InReg.DI = SADD(ConditionedServer$) 'load DI with offset of ConditionedServer$
'execute interrupt
CALL InterruptX(&H21, InReg, OutReg)
IF (OutReg.FLAGS AND 1) THEN
'we have no more logins - bail out
EXIT DO
ELSE
'we have another login - count it
LoginCount% = LoginCount% + 1
END IF
'is the login counter pointing to the 'window' we want to display?
IF (LoginCount% >= PageStart%) AND (LoginCount% <= (PageStart% + 10)) THEN
'calculate virtual circuit number
VCID# = ASC(MID$(UserEntry$, 1, 1))
VCID# = VCID# + (ASC(MID$(UserEntry$, 2, 1)) * (2 ^ 8))
'calculate I/O bytes
InOut# = ASC(MID$(UserEntry$, 5, 1))
InOut# = InOut# + (ASC(MID$(UserEntry$, 6, 1)) * (2 ^ 8))
InOut# = InOut# + (ASC(MID$(UserEntry$, 7, 1)) * (2 ^ 16))
InOut# = InOut# + (ASC(MID$(UserEntry$, 8, 1)) * (2 ^ 24))
InOut# = InOut# + (ASC(MID$(UserEntry$, 9, 1)) * (2 ^ 32))
'calculate requests
Requests# = ASC(MID$(UserEntry$, 10, 1))
Requests# = Requests# + (ASC(MID$(UserEntry$, 11, 1)) * (2 ^ 8))
Requests# = Requests# + (ASC(MID$(UserEntry$, 12, 1)) * (2 ^ 16))
'print data to screen
SELECT CASE DisplayOption%
CASE 0
LOCATE Vert%, 2: PRINT RIGHT$("000" + HEX$(VCID#), 4);
LOCATE Vert%, 7: PRINT MID$(UserEntry$, 29, 15);
LOCATE Vert%, 23: PRINT MID$(UserEntry$, 13, 15);
LOCATE Vert%, 39: PRINT State$(ASC(MID$(UserEntry$, 3, 1)));
LOCATE Vert%, 48: PRINT USING "##,###,###"; Requests#;
LOCATE Vert%, 59: PRINT USING "#,###,###,###,###"; InOut#;
LOCATE Vert%, 77: PRINT USING "###"; ASC(MID$(UserEntry$, 4, 1));
CASE 1
LOCATE Vert%, 2: PRINT MID$(UserEntry$, 13, 15);
LOCATE Vert%, 18: PRINT State$(ASC(MID$(UserEntry$, 3, 1)));
LOCATE Vert%, 27: PRINT USING "##,###,###"; Requests#;
LOCATE Vert%, 38: PRINT USING "#,###,###,###,###"; InOut#;
LOCATE Vert%, 56: PRINT LastCmd$(ASC(MID$(UserEntry$, 4, 1)));
END SELECT
'point to next print line in display window
Vert% = Vert% + 1
END IF
LOOP
'if data did not fill all window lines then blank-out the rest
FOR Index% = Vert% TO 16
SELECT CASE DisplayOption%
CASE 0
LOCATE Index%, 2: PRINT SPACE$(4);
LOCATE Index%, 7: PRINT SPACE$(15);
LOCATE Index%, 23: PRINT SPACE$(15);
LOCATE Index%, 39: PRINT SPACE$(8);
LOCATE Index%, 48: PRINT SPACE$(10);
LOCATE Index%, 59: PRINT SPACE$(17);
LOCATE Index%, 77: PRINT SPACE$(3);
CASE 1
LOCATE Index%, 2: PRINT SPACE$(15);
LOCATE Index%, 18: PRINT SPACE$(8);
LOCATE Index%, 27: PRINT SPACE$(10);
LOCATE Index%, 38: PRINT SPACE$(17);
LOCATE Index%, 56: PRINT SPACE$(24);
END SELECT
NEXT Index%
'are there any entries above window?
LOCATE 6, 80
IF PageStart% > 1 THEN
COLOR ArowFG%, ArowBG%
PRINT CHR$(24);
ELSE
COLOR BrdrFG%, BrdrBG%
PRINT CHR$(186);
END IF
'are there any entries below window?
LOCATE 16, 80
IF (PageStart% + 10) < LoginCount% THEN
COLOR ArowFG%, ArowBG%
PRINT CHR$(25);
ELSE
COLOR BrdrFG%, BrdrBG%
PRINT CHR$(186);
END IF
END SUB 'UpdateScreen